home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / biz / demo / Reflections4De.lha / Ref4Demo / skripte.lha / kegelstu.skr < prev    next >
Text File  |  1996-07-26  |  2KB  |  124 lines
  1. REFSKRIPT
  2. GET_XY Breite_des_Kegels Unten Oben
  3. RETURN_IF_ABBRUCH 0
  4. GET_RESULT res
  5. COPY_WORD res 1
  6. GET_RESULT breite_unten
  7. COPY_WORD res 2
  8. GET_RESULT breite_oben
  9. GET_REAL Höhe des Kegels
  10. RETURN_IF_ABBRUCH 0
  11. GET_RESULT hoehe
  12. GET_INT #Seqmente 
  13. RETURN_IF_ABBRUCH 0
  14. GET_RESULT nseq
  15.  
  16. DIV hoehe 2
  17. GET_RESULT h2
  18. MUL h2 -1
  19. GET_RESULT h2_min
  20. DIV breite_unten 2
  21. GET_RESULT rad_unten
  22. DIV breite_oben 2
  23. GET_RESULT rad_oben
  24.  
  25. ; Dreiecks-Objekt erzeugen */
  26. OBJ_new kegel_stumpf 3
  27. GET_RESULT k
  28. GEO_NEW_PT k
  29. GET_RESULT i0
  30. GEO_NEW_PT k
  31. GET_RESULT i1
  32. GEO_SET_PT k i0 0 0 h2_min
  33. GEO_SET_PT k i1 0 0 h2
  34. SET_VAR i 1
  35. SET_VAR winkel 0
  36. SUB nseq 1
  37. GET_RESULT ns1
  38. DIV 360 nseq
  39. GET_RESULT dw
  40. >do_loop1:
  41.    SIN winkel
  42.    GET_RESULT si
  43.    COS winkel
  44.    GET_RESULT co
  45.    MUL si rad_unten
  46.    GET_RESULT y
  47.    MUL co rad_unten
  48.    GET_RESULT x
  49.  
  50.    GEO_NEW_PT k
  51.    GET_RESULT j
  52.    GEO_SET_PT k j x y h2_min
  53.    ADD winkel dw
  54.    GET_RESULT winkel
  55.    ADD i 1
  56.    GET_RESULT i
  57.    IF_GREATER_GOTO i nseq fert1
  58.    GOTO do_loop1
  59. >fert1:
  60. SET_VAR i 1
  61. SET_VAR winkel 0
  62. DIV 360 nseq
  63. GET_RESULT dw
  64. >do_loop2:
  65.    SIN winkel
  66.    GET_RESULT si
  67.    COS winkel
  68.    GET_RESULT co
  69.    MUL si rad_oben
  70.    GET_RESULT y
  71.    MUL co rad_oben
  72.    GET_RESULT x
  73.  
  74.    GEO_NEW_PT k
  75.    GET_RESULT j
  76.    GEO_SET_PT k j x y h2
  77.    ADD winkel dw
  78.    GET_RESULT winkel
  79.    ADD i 1
  80.    GET_RESULT i
  81.    IF_GREATER_GOTO i nseq fert2
  82.    GOTO do_loop2
  83. >fert2:
  84. ; Jetzt die dreiecke erzeugen 
  85. ADD i1 1
  86. GET_RESULT i2
  87. ADD i2 nseq
  88. GET_RESULT i3
  89. SET_VAR i 0
  90. >do_loop3:
  91. ; boden_dreieck
  92.    ADD i 1
  93.    GET_RESULT ip1
  94.    MOD ip1 nseq
  95.    GET_RESULT ip1
  96.    ADD i2 i
  97.    GET_RESULT p
  98.    ADD i2 ip1
  99.    GET_RESULT q
  100.    
  101.    DREI_NEW_DREI k i0 q p
  102. ; jetzt zwischen_dreiecke
  103.    ADD i3 i
  104.    GET_RESULT p1
  105.    ADD i3 ip1
  106.    GET_RESULT q1
  107.    
  108.    DREI_NEW_DREI k p q q1 1
  109.    DREI_NEW_DREI k p q1 p1 1
  110. ; decken_dreieck
  111.    DREI_NEW_DREI k i1 p1 q1
  112.    
  113.    ADD i 1
  114.    GET_RESULT i
  115.    IF_GREATER_GOTO i nseq fert3
  116.    IF_EQUAL_GOTO i nseq fert3
  117.    GOTO do_loop3
  118. >fert3:
  119. PKL_ADD k
  120. ZENTRIEREN k
  121. PLOT_PKL
  122.  
  123. RETURN 1
  124.